Netware Super Library/Netware Super Library.iso/pgm_tool/nwtp06/phone.pas

Pascal/Delphi Source File | 1995-03-01 | 24.7 KB | 819 lines

Program Phone;
{$IFDEF VER70}
{$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P+,Q-,R-,S-,T-,V-,X+}
{$ELSE}
{$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X+}
{$ENDIF}

{ Source code for Borland/Turbo Pascal 6/7.
  To be compiled with NwTP version 0.6 or higher.
  NwTP is a FreeWare Netware Interface for Pascal.
}

{ Based on the phone.pas program by Eduardo M. Serrat,
  as published in Dr.Dobbs #207, November 1993.

  The NwTP units and this adaption of his program are
  (c) 1993,1995 by Rene Spronk ,Groningen, the Netherlands. }

uses dos,crt,nwMisc,nwBindry,nwConn,nwMess,nwServ,nwIPX;

const Socket  = $80C3;
      { This socket was assigned by Novell to an IPX Chatprogram by OXXI }
      { Don't use this program in conjunction with theirs..              }
Var
   SendECB,
   ListenECB      :TEcb;                     { Definition of ECBs        }
   SendIpxHeader,
   ListenIPXheader:TIpxHeader;               { Definition of IPX Headers }
   SendData,
   ReadData       :Array [1..100] of Byte;    { Data area of packets      }
   readflg        :Boolean;  { Flag to signal received packets }

   MyConnNbr      :Byte;
   MyAddress      :TinternetworkAddress;
   MyName         :String;
   MyServerId     :Byte;
   MyServerName   :String;
   myx,myy        :Byte;  { my viewport cursor position }

   RconnNbr       :Byte;
   Raddress       :TinterNetworkAddress;
   Rname          :String;
   RfullName      :String;
   RserverID      :Byte;
   RserverName    :String;
   LocalTarget    :TnodeAddress;  { Node Address of bridge to remote address }

   NewStack       :Array[1..256] of Word;   { !! used by ESR }
   StackBottom    :Word;                    { !! used by ESR }
   HeapCheckPtr   :pointer;  { Pointer that holds heapPointers }

{---------------------------------------------------------------------------}

Procedure CheckError(b:Boolean;errCode:Word; mess:String);
begin
IF b
 then begin
      writeln;
      CASE errCode of
       { main body: 0000-000F }
       $0001:writeln('IPX not installed.');
       $0002:writeln('Error opening socket.');
       { Procedure whoami }
       $0010:writeln('Error whilst determining connectionnumber.');
       $0011:writeln('Error determining internet address.');
       $0012:writeln('Error retreiving connection information.');
       { Procedure process input command }
       $0022:writeln('Servername ',mess,' is invalid.');
       $0023:writeln('Error interpreting connection number parameter :',mess);
       $0025:begin
             writeln('The supplied username is not unique,');
             writeln('or the target user isn''t logged in.');
             end;
       $0026:writeln('Please select a target user from the above list.');
       $0027:writeln('Phone cancelled.');
       { handshake with sender }
       $0032:writeln('Packet received from a user claiming to be ConnectionNumber $',mess);
       { Sendbroadcast message in Procedure HandshakeWithreceiver }
       $1000: writeln('Error: Broadcasting a message to the target user failed.');
       $10FC: begin
              Writeln('The target user is logged in, but appears not to be at his/her workstation:');
              writeln('The (last) message was rejected, message buffer for the target station is full.');
              end;
       $10FD: begin
              Writeln('The connection number of the target user has become invalid,');
              Writeln('Most likely because the user has logged out.');
              end;
       $10FF: begin
              Writeln('The target user is logged in, but has blocked incoming messages.');
              end;
      else writeln('An unspecified error occurred.');
      end; {case }
      if errCode>$000F then IPXcloseSocket(socket);
      if errCode>$001F
       then begin
            SetPreferredConnectionId(MyServerId);
            release(HeapCheckPtr);
            end;
      if ((errCode=$0026) or (errCode=$0027))
       then halt(0)
       else halt(1);
      end;
end;

{-----------------------------------------------------------------------------}

Function Confirm:Boolean;
Var ch:char;
begin
repeat
  repeat {} until keypressed;
  ch:=readkey;
  if ch=#0 then ch:=readkey;
until ch IN ['y','Y','n','N'];
Confirm:=((ch='Y') or (ch='y'))
end;

{-----------------------------------------------------------------------------}

{$F+}
Procedure ESRproc;
begin
 ReadFlg:=true;
end;

Procedure ESRHandler; assembler;
asm { ES:SI are the only valid registers when entering this Procedure ! }
    mov dx, seg stackbottom
    mov ds, dx

    mov dx,ss  { setup of a new local stack }
    mov bx,sp  { ss:sp copied to dx:bx}
    mov ax,ds
    mov ss,ax
    mov sp,offset stackbottom
    push dx
    push bx

    CALL EsrProc

    pop bx
    pop dx
    mov sp,bx
    mov ss,dx
end;
{$F-}

{-----------------------------------------------------------------------------}

Function SameAddress(Var a,b):Boolean;
{ check if networkaddress a and b have the same net and node address }
Type Taddress=Array[1..10] of char;
Var addrA:Taddress ABSOLUTE a;
    addrB:Taddress ABSOLUTE b;
begin
SameAddress:=(addrA=addrB);
end;

{----------------------------------------------------------------------------}

Function Time:String;
   Function LeadingZero(w:Word):String;
   Var s : String;
   begin
   Str(w:0,s);
   if Length(s) = 1
    then s := '0' + s;
   LeadingZero := s;
   end;
Var h, m, s, hund : Word;
begin
GetTime(h,m,s,hund);
Time:=LeadingZero(h)+':'+LeadingZero(m)+':'+LeadingZero(s);
end;

{-----------------------------------------------------------------------------}
Procedure HandshakeWithReceiver;
const Progress  :  Array [1..4] of char = ('/','─','\','|');
Var
   SecondInd   :Word;
   ProgressInd :Byte;
   x,y         :Byte;
   KeyNbr      :Byte;
   ConnUp      :Boolean;

   ObjName     :String;
   ObjType     :Word;
   ObjId       :LongInt;
   LogonTime   :TnovTime;

   Message     :String;
   ConnList,
   ResultList  :TconnectionList;
begin
Writeln('Calling User ',Rname);
Write('Press <ESC> to cancel [ ]');
x:=wherex-2; y:=wherey;
Message:='User '+MyName+' is phoning you........... ['+Time+']';
SecondInd:=0; ProgressInd:=1;

SetPreferredConnectionId(RserverId);
ConnList[1]:=RconnNbr;
SendBroadcastMessage(message,1,ConnList,ResultList);
Checkerror(nwMess.result>0,$1000,'');
CheckError(ResultList[1]>0,$1000+ResultList[1],'');

IPXListenForPacket(ListenECB);

KeyNbr:=$ff;
ConnUp:=False;
FillChar(SendData,SizeOf(SendData),#0);
SendData[1]:=Hi(MyConnNbr);
SendData[2]:=Lo(MyConnNbr);
Move(MyServerName[1],SendData[3],ord(MyserverName[0]));
Move(MyName[1],SendData[50],ord(Myname[0]));

repeat { send a packet every 4 seconds and a broadcast message every 30 seconds }
  gotoxy(x,y);
  write(Progress[ProgressInd]);
  inc(ProgressInd);
  if ProgressInd > 4
   then begin
        ProgressInd:=1;
        IPXSendPacket(SendECB);
        end;
  inc(SecondInd);
  if SecondInd = 30
   then begin
        SendBroadcastMessage(message,1,ConnList,ResultList);
        Checkerror(nwMess.result>0,$1000,'');
        CheckError(ResultList[1]>0,$1000+ResultList[1],'');
        SecondInd:=0;
        end;
  delay(1000);
  if readflg
   then begin
        writeln('recieved a packet..');
         if not SameAddress(ListenIPXheader.source,Raddress)
          then begin
               readflg:=false;
               IPXListenForPacket(ListenECB);
               end
          else ConnUp:=TRUE;
        end;
  if keypressed
   then KeyNbr:=ord(readkey);

until (KeyNbr = $1b) or ConnUp;

if KeyNbr = $1b
 then begin
      Writeln;
      Write('Wait...');
      Delay(5000);
      SendData[1]:=$1b;
      IPXSendPacket(SendECB);
      message:='The user phoning you canceled the call... ['+Time+']';
      SendBroadcastMessage(message,1,ConnList,ResultList);
      IpxCloseSocket(Socket);
      SetPreferredConnectionID(MyServerId);
      halt(1);
      end;
Writeln;
Write('User ',Rname,' answered your call......!');
delay(1200);
ReadFlg:=false;
end;

{--------------------------------------------------------------------------}

Procedure HandshakeWithSender;
const Progress:Array [1..4] of char = ('/','─','\','|');
Var p        :Byte;
    ObjType  :Word;
    ObjId    :LongInt;
    LoginTime:TnovTime;
    ticks    :Word;
    x,y      :Word;
begin
Writeln('Listening for calls..');
Write('Press <ESC> to cancel [ ]');
x:=wherex-2; y:=wherey;
IPXListenForPacket(ListenECB);
p:=1;
while(p<=4) and (not ReadFlg)
 do begin
    gotoxy(x,y);
    write(Progress[p]);
    delay(1200);
    inc(p);
    end;
If not readflg
 then begin
      Writeln;
      Writeln('Nobody is Calling you..........');
      writeln;
      writeln('( PHONE ? for help )');
      IpxCloseSocket(Socket);
      SetPreferredConnectionId(MyServerId);
      halt(1);
      end
else  begin
      readflg:=false;
      Raddress:=ListenIPXheader.source;
      Raddress.socket:=Socket;
      RconnNbr:=(ReadData[1]*256)+ReadData[2];
      ZstrCopy(RserverName,ReadData[3],47);
      ZstrCopy(Rname,ReadData[50],47);
      IPXGetLocalTarget(Raddress,LocalTarget,ticks);
      IPXSetupSendECB(NIL, Socket, Raddress,
                      Addr(SendData), SizeOf(SendData),
                      SendIPXheader,SendECB);
      IPXSendPacket(SendECB); { acknowledge by sending a packet. Packet contents unimportant. }
      end;
end;


{-----------------------------------------------------------------------------}

Procedure InitWindows;
Var i: Byte;
begin
ClrScr;
myx:=1; myy:=1;
gotoxy(1,1);
write('╔'); for i:=2 to 79 do write('═'); write('╗');
write('║'); for i:=2 to 79 do write(' '); write('║');

gotoxy(3,2);
Write('User: '+MyName+' ░ Server: '+MyServerName);
write(' ░ Connection: '); write(MyConnNbr);
gotoxy(1,3);
write('╚'); for i:=2 to 79 do write('═'); write('╝');

gotoxy(1,13);
write('╔'); for i:=2 to 79 do write('═'); write('╗');
write('║'); for i:=2 to 79 do write(' '); write('║');

gotoxy(3,14);
Write('User: '+Rname+' ░ Server: '+RserverName);
Write(' ░ Connection: '); write(RconnNbr);
Gotoxy(1,15);
write('╚'); for i:=2 to 79 do write('═'); write('╝');

gotoxy(26,25);
Write('▒▒▒▓▓▓ Phone Utility ▓▓▓▒▒▒');
gotoxy(1,1);
HighVideo;
end;

{-----------------------------------------------------------------------------}

Procedure Talk;

    Function Timeout(w1,w2:Word;sec:Byte):Boolean;
    Var lw2:Longint;
    begin
    if w2<w1
     then lw2:=$10000+w2
     else lw2:=w2;
    Timeout:=((lw2-w1) DIV 18)>sec;
    end;

    Procedure MyWindow;
    begin
    Window(1,5,80,12);
    gotoxy(myx,myy);
    end;

    Procedure RemoteWindow;
    begin
    Window(1,17,80,24);
    end;


Var currMarker,
    SendMarker,
    ListenMarker:Word;
    ch          :Char;
    RlastChar,
    RlastX,
    RlastY      :byte;
begin
MyWindow;
IPXListenForPacket(ListenECB);
IPXSetupSendECB(NIL, Socket, Raddress, Addr(SendData), 7,
          SendIPXheader,SendECB);  { make size of sendBuffer smaller }
IPXgetIntervalMarker(SendMarker);
ListenMarker:=SendMarker;
SendData[1]:=$FF;
RlastChar:=$FF;

REPEAT
 if keypressed
  then begin
       MyWindow;
       SendData[4]:=SendData[1];  { append last typed char to packet. }
       SendData[5]:=SendData[2];  { original packet may have been lost }
       SendData[6]:=SendData[3];  { Remember: IPX is unreliable ! }
       ch:=readkey;
       if ch=#0
        then begin
             ch:=readkey;
             CASE ord(ch) of
              75:begin { <- 'cursor left' }
                 SendData[2]:=myx-1;
                 if (myx=1) then SendData[2]:=1;
                 gotoxy(SendData[2],myy);
                 SendData[3]:=myy;
                 SendData[1]:=$00;
                 end;
              77:begin { -> 'cursor right' }
                 SendData[2]:=myx+1;
                 if (myx=80) then SendData[2]:=80;
                 gotoxy(SendData[2],myy);
                 SendData[3]:=myy;
                 SendData[1]:=$00;
                 end;
             else SendData[1]:=$FF;
             end; {case}

             end
        else begin
             SendData[1]:=ord(ch);
             SendData[2]:=myx;
             SendData[3]:=myy;
             Case ord(SendData[1]) of
              8 :write(#8+#$20+#8); { backspace }
              13:writeln;           { return    }
             else write(chr(SendData[1]));
             end; {case}
             end;
       myx:=wherex;
       myy:=wherey;
       IPXSendPacket(SendECB);           { send current and previous char }
       IPXGetIntervalMarker(SendMarker);
       end;

 if readflg
  then begin
       If SameAddress(ListenIPXheader.source,Raddress)
        then begin
             if (readData[4]<>$FF)
              and (   (readData[4]<>RlastChar)
                   or (readData[5]<>Rlastx)
                   or (readData[6]<>Rlasty)
                  )
             then begin   { if we missed a packet, display char now }
                  RemoteWindow;
                  Gotoxy(ReadData[5],ReadData[6]);
                  CASE ReadData[4] of
                   0:begin { don't print, cursor movement only }
                     end;
                   8:write(#8+#$20+#8);  { backspace }
                  13:writeln;            { return    }
                  else write(chr(ReadData[1]));
                  end;{case}
                  end;

             if ReadData[1]<>$FF
              then begin
                   RemoteWindow;
                   Gotoxy(ReadData[2],ReadData[3]);
                   CASE ReadData[1] of
                    0:begin { don't print, cursor movement only }
                      end;
                    8:write(#8+#$20+#8);
                   13:writeln;
                   else write(chr(ReadData[1]));
                   end;{case}
                   end;
             RlastChar:=ReadData[1];
             RlastX   :=ReadData[2];
             RlastY   :=ReadData[3];
             IPXGetIntervalMarker(ListenMarker);
             end;
       readflg:=false;
       IPXListenForPacket(ListenECB);
       end;

 IPXRelinquishControl;
 IPXGetIntervalMarker(currMarker);
 IF Timeout(SendMarker,currMarker,5)  { send an "I'm alive" msg after 5 idle secs }
  then begin
       SendData[4]:=SendData[1];  { redundant info: append last char to packet. }
       SendData[5]:=SendData[2];
       SendData[6]:=SendData[3];
       SendData[1]:=$FF;
       IPXSendPacket(SendECB);
       IPXGetIntervalMarker(SendMarker);
       end;
 IF Timeout(ListenMarker,currMarker,17) { fake an "hang-up" if no msgs received during 17 secs }
  then begin
       ReadData[1]:=$1B;
       RemoteWindow;
       end;
UNTIL (ReadData[1]=$1b) or (SendData[1]=$1b); { .. until either party has hung up }

SendData[1]:=$1b;
IPXSendPacket(SendECB);
IpxCloseSocket(Socket);
Writeln;
Writeln;
writeln('<Hanging Up...........>');
Delay(2000);
Window(1,1,80,25);
LowVideo;
gotoxy(80,25);
end;

{--------------- ProcessInputCommand----------------------------------------}

Type PusrInfo=^TusrInfo;
     TusrInfo=record
              ObjName :String[47];
              FullName:String[40];
              ConnId,
              ConnNbr :Byte;
              Address :TinterNetworkAddress; { socket field not used }
              next    :PusrInfo;
              end;

Var startInfo:PusrInfo;

Procedure PushInLL(_objName,_objFullName:String;
                   _connId,_connNbr:Byte;
                   _address:TinternetworkAddress);
Var p,m,l:PusrInfo;
begin
p:=startInfo;
new(l);
With l^
 do begin
    if _objFullName[0]>#40
     then _objFullName[0]:=#40;
    objName:=_objName;
    fullName:=_objFullName;
    connId:=_connId;
    connNbr:=_connNbr;
    address:=_address;
    next:=NIL;
    end;
if p=NIL
 then startInfo:=l
 else begin
      m:=p;
      While (p<>NIL) and (p^.objName<=_obJname)
       do begin m:=p;p:=p^.next; end;
      if p=startInfo
       then begin { insert before first LL entry }
            l^.next:=startInfo;
            startInfo:=l;
            end
       else begin { insert in LL or append to end }
            l^.next:=m^.next;
            m^.next:=l;
            end;
      end;
end;

Function GetTargetUser:PusrInfo;
{ returns NIL if a target user was not uniquely identified by the user }
Var l            :PusrInfo;
    serverName   :String;
    SelectedUsers:Word;
    t            :Word;
    s            :String;
    ch           :char;
    Laddr        :TinternetworkAddress;
    AddrSame     :boolean;
begin
{ are all objNames the same?
   Yes => multple logins (connNbr must have been supplied)
          or login on multiple servers (serverName must h.b. supplied)
   No => the supplied userName is not unique. }
l:=startInfo;
SelectedUsers:=0;
IF l<>NIL
 then Laddr:=l^.address;
AddrSame:=true;
While (l<>NIL)
 do begin
    inc(SelectedUsers);
    AddrSame:=AddrSame and SameAddress(Laddr,l^.address);
    l:=l^.next;
    end;
If AddrSame { are all the users essentially the same ? }
 then SelectedUsers:=1;

CASE SelectedUsers of
 0:begin
   GetTargetUser:=NIL;
   end;
 1:begin { OK! unique users identified }
   GetTargetUser:=StartInfo;
   end;
 else begin
      writeln('The target user has multiple connections.');
      writeln('Please give connection number and/or server name of the intended user.');
      writeln;
      writeln('Username             | Server          | Con | Full Name');
      writeln('---------------------+-----------------+-----+----------------------');

      t:=3;
      l:=startInfo;
      while l<>NIL
       do begin
          GetFileServerName(l^.connId,servername);
          PstrCopy(s,l^.objName,20);
          write(s,' | ');
          PstrCopy(s,serverName,15);
          write(s,' | ',l^.connNbr:3,' | ');
          PstrCopy(s,l^.fullname,30);
          writeln(s);
          l:=l^.next;
          inc(t);
          if t=20
           then begin
                writeln('--- more (any key)---');
                repeat {} until keypressed;
                ch:=readkey;
                if ch=#0 then ch:=readkey;
                t:=0;
                end;
          end;
      GetTargetUser:=NIL;
      end;
 end; {case}
end;

Procedure ProcessInputCommand;
Var SearchStartServer,
    SearchEndServer   :Byte;
    ConnIdCtr,
    ConnNbrCtr        :Byte;

    LuserName,
    LserverName       :String;
    LconnId           :Byte;
    LfullName         :String;
    LconnNbr          :Byte;

    ServerInfo        :TFileServerInformation;
    objName           :String;
    objType           :Word;
    objId             :Longint;
    ticks             :Word;
    LoginTime         :TnovTime;
    IntNWaddress      :TinternetworkAddress;

    TargetUserPtr     :PusrInfo;

    p                 :Byte;
    errcode           :Integer;
begin
StartInfo:=NIL;
If (ParamCount>0)
   and ( (pos('?',paramstr(1))>0)
         or (pos('help',paramstr(1))>0)
         or (pos('HELP',paramstr(1))>0)
       )
 then begin
      writeln;
      writeln('** Phone V 1.3., By E.M. Serrat and R. Spronk');
      writeln;
      writeln('** Usage: PHONE');
      writeln;
      writeln('Listen for others calling you.');
      writeln;
      writeln;
      writeln('** Usage: PHONE [servername/]UserName [connection]');
      writeln;
      writeln('Call someone.');
      writeln('-Username may be a ''*'' wildcard.');
      writeln(' All logged in users on all attached servers will be shown.');
      writeln('-Sender and receiver must be attached to a common server in the internetwork.');
      writeln('-The supplied username is compared with the first characters of');
      writeln(' the login name and with the full user name, as set by SYSCON.');
      writeln('-Servername must be supplied if the target user has connections');
      writeln(' with more than one server.');
      writeln('-ConnectionNumber must be supplied if the target user is logged in');
      writeln(' at multiple workstations attached to the same server.');
      writeln;
      writeln('The program will timeout if the program on the other end of the link');
      writeln('is terminated abnormally.');
      halt(1);
      end;
if paramcount=0 { ---- Listen if anyone is calling us ----- }
 then begin
      HandshakeWithSender;
      InitWindows;
      Talk;
      IpxCloseSocket(Socket);
      SetPreferredConnectionId(MyServerId);
      halt(0);
      end;
{ ** Paramcount>0, We're calling someone ** }
LconnNbr:=0;
SearchStartServer:=1;
SearchEndServer:=8;
LuserName:=ParamStr(1);
UpString(LuserName);
p:=pos('/',LuserName);
checkError((p=1) and (LuserName[0]=#1),$0020,'');
if p>0
 then begin
      LserverName:=copy(LuserName,1,p-1);
      delete(LuserName,1,p);
      if LuserName=''
       then LuserName:='*';
      if pos('*',LserverName)=0
       then begin
            GetConnectionId(LserverName,LconnId);
            checkError(nwConn.result>0,$0022,LserverName);
            SearchStartServer:=LconnId;
            SearchEndServer:=LconnId;
            end;
      end;
if paramcount>1
 then begin
      Val(ParamStr(2),LconnNbr,errcode);
      checkError(errcode<>0,$0023,Paramstr(2));
      end;

writeln('Scanning logged in users..');
ConnIdCtr:=SearchStartServer;
While ConnIdCtr<=SearchEndServer
 do begin
    If IsConnectionIdInUse(ConnIdCtr)
     then begin
          SetPreferredConnectionId(ConnIdCtr);
          IF NOT GetFileServerInformation(ServerInfo)
           then ServerInfo.connectionsMax:=250; { patch value if call failed }
          for ConnNbrCtr:=1 to ServerInfo.ConnectionsMax
           do begin
              IF GetConnectionInformation(ConnNbrCtr,ObjName,objType,objId,LoginTime)
                 and (objType=OT_USER)
               then begin
                    GetInterNetAddress(ConnNbrCtr,IntNWaddress);
                    GetRealUserName(ObjName,LfullName);
                    UpString(LfullName);
                    IF (pos('NOT-LOGGED-',objName)=0)        { skip not logged in connections }
                      and ((LconnNbr=0) or (LconnNbr=ConnNbrCtr))     { if user supplied connNbr, check it }
                      and (NOT SameAddress(MyAddress,IntNWAddress)) { no mail to yourself }
                      and ( (LuserName[1]='*')               { wildcard overrules nameselection }
                            or (pos(LuserName,ObjName)=1)    { username matched with firts few characters in objName? }
                            or (pos(LuserName,LfullName)>0)  { usermane matches part of objects' Full_Name ? }
                          )
                     then PushInLL(objName,LfullName,ConnIdCtr,ConnNbrCtr,
                                   IntNWaddress);
                    end;
              end;
          end;
    inc(ConnIdCtr);
    end;
TargetUserPtr:=GetTargetUser;
checkError((LuserName[1]<>'*') and (TargetUserPtr=NIL),$0025,''); { No user selected }
checkError(TargetUserPtr=NIL,$0026,'');
RconnNbr:=TargetUserPtr^.connNbr;
Raddress:=TargetUserPtr^.address;
Raddress.Socket:=Socket;
Rname:=TargetUserPtr^.objName;
RserverId:=TargetUserPtr^.connId;
GetFileServerName(RserverId,RserverName);
release(HeapCheckPtr);

SetPreferredConnectionId(RserverId);
GetRealUserName(Rname,RfullName);
writeln;
writeln(RserverName,'/',Rname,' Connection_Number= ',RconnNbr);
writeln('(Full name =',RfullName,')');
writeln;
write('Is the above user the intended chat partner ? (Y/N)');
checkError(NOT Confirm,$0027,''); { user abort }
writeln;

IPXGetLocalTarget(Raddress,LocalTarget,ticks);
IPXSetupSendECB(NIL, Socket, Raddress, Addr(SendData), SizeOf(SendData),
                SendIPXheader,SendECB);
HandShakeWithReceiver;
InitWindows;
Talk;
IpxCloseSocket(Socket);
SetPreferredConnectionId(MyServerId);
halt(0);
end;

Procedure WhoAmI; {---------------------------------------------------------}
Var ObjType  :Word;
    ObjId    :LongInt;
    LogonTime:TnovTime;
begin
GetConnectionNumber(MyConnNbr);
checkError(nwConn.result>0,$0010,'');
GetInternetAddress(MyConnNbr,MyAddress);
checkError(nwConn.result>0,$0011,'');
MyAddress.Socket:=Socket;
GetConnectionInformation(MyConnNbr,MyName,ObjType,ObjId,LogonTime);
checkError(nwConn.result>0,$0012,'');
GetEffectiveConnectionID(MyServerId);
GetFileServerName(MyServerId,MyServerName);
end;

{-----------------------------------------------------------------------------}
Var LocSocket:Word;

begin
Writeln('*** PHONE V1.3 ***');
Mark(HeapCheckPtr);
LocSocket:=Socket;
readflg:=false;
Checkerror(NOT IpxPresent,$0001,'');
IpxOpenSocket(LocSocket,FALSE);
Checkerror(nwIPX.result>0,$0002,'');
WhoAmI;
IPXSetupListenECB(Addr(EsrHandler),socket,Addr(ReadData),SizeOf(ReadData),
                  ListenIPXheader,ListenECB);
ProcessInputCommand; {doesn't return}
end.